home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / drawer.zip / CANVAS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  8KB  |  374 lines
  1. {$L-,D-}
  2.  
  3. unit Canvass;
  4.  
  5. interface
  6.  
  7. uses
  8.     Shape;
  9.  
  10. const
  11.  
  12.     MAXCANVASSHAPES = 50;
  13.  
  14. type
  15.  
  16.     Canvas =     object
  17.                     x1, y1, x2, y2 : word;
  18.                     NumShapes : word;
  19.                     Shapes : array[1..MAXCANVASSHAPES] of Shape;
  20.                     procedure Initialize( x1, y1, x2, y2 : word);
  21.                     function  PtInRegion( x, y : word) : boolean;
  22.                     function  AddShape( s : shape) : boolean;
  23.                     procedure Delete;
  24.                     procedure Copy;
  25.                     function  ObjectAt( x, y : word) : Shape;
  26.                     procedure SelectObject( s : Shape );
  27.                     procedure Lasso( lx1, ly1, lx2, ly2 : word);
  28.                     procedure Move( dx, dy : integer);
  29.                     procedure Size( dx, dy : integer);
  30.                     Procedure ChangeColor( newcolor : word);
  31.                     procedure GetRange( var rx1, ry1, rx2, ry2 : word);
  32.                     function  PtInSelection( x, y : word) : boolean;
  33.                     procedure UnSelectObject( s : Shape );
  34.                     procedure SelectAllObjects;
  35.                     procedure UnSelectAllObjects;
  36.                     function  SelectedObject( s : Shape ) : Shape;
  37.                     function  OnHandle( px, py : word) : boolean;
  38.                     procedure Draw;
  39.                     procedure Erase;
  40.                     procedure Save( fn : string);
  41.                     procedure Load( fn : string);
  42.                 end;
  43.  
  44. implementation
  45.  
  46. uses MSGraph, Utility;
  47.  
  48. const
  49.     CANVASSTAMP : word = $0160;
  50.  
  51. procedure Canvas.Initialize( x1, y1, x2, y2 : word);
  52. begin
  53.     self.x1 := x1;
  54.     self.y1 := y1;
  55.     self.x2 := x2;
  56.     self.y2 := y2;
  57.     self.NumShapes := 0;
  58. end;
  59.  
  60. function Canvas.PtInRegion( x, y : word) : boolean;
  61. begin
  62.     with self do
  63.         PtInRegion := (x>=x1) and (x<=x2) and (y>=y1) and (y<=y2);
  64. end;
  65.  
  66. function Canvas.AddShape( s : shape ) : boolean;
  67. begin
  68.     if self.NumShapes < MAXCANVASSHAPES then begin
  69.         inc(self.NumShapes);
  70.         self.Shapes[self.NumShapes] := s;
  71.         AddShape := TRUE;
  72.         end
  73.     else
  74.         AddShape := FALSE;
  75. end;
  76.  
  77. procedure Canvas.Delete;
  78. var
  79.     n : word;
  80.  
  81.     procedure MoveUp;
  82.     var
  83.         n2 : word;
  84.     begin
  85.         for n2 := n+1 to self.NumShapes do
  86.             self.Shapes[n2-1] := self.Shapes[n2];
  87.     end;
  88.  
  89. begin
  90.     with self do begin
  91.         n := 1;
  92.         while n <= NumShapes do
  93.             if self.Shapes[n].Selected then begin
  94.                 self.Shapes[n].Erase;
  95.                 Dispose( self.Shapes[n] );
  96.                 MoveUp;
  97.                 Dec(NumShapes);
  98.                 end
  99.             else
  100.                 inc(n);
  101.         end;
  102. end;
  103.  
  104. procedure Canvas.Copy;
  105. var
  106.     n : word;
  107.     s : shape;
  108. begin
  109.     for n := 1 to self.NumShapes do
  110.         if self.Shapes[n].Selected then begin
  111.             s := self.Shapes[n].clone;
  112.             s.Move( 4, 4);
  113.             self.Shapes[n].UnSelect;
  114.             s.Select;
  115.             if not self.AddShape(s) then Dispose(s);
  116.             end;
  117. end;
  118.  
  119. procedure Canvas.Draw;
  120. var
  121.     n : word;
  122. begin
  123.     for n := 1 to self.NumShapes do
  124.         self.Shapes[n].Draw;
  125. end;
  126.  
  127. procedure Canvas.Erase;
  128. begin
  129.     _SetColor(0);
  130.     with self do _Rectangle( _GFILLINTERIOR, x1, y1, x2, y2);
  131. end;
  132.  
  133. function Canvas.SelectedObject( s : shape) : Shape;
  134. var
  135.     n : word;
  136. begin
  137.     { if s=NIL, find first selected object.  Else, find the
  138.       one selected after s (if any) }
  139.     for n := 1 to self.NumShapes do
  140.         if self.Shapes[n].Selected then
  141.             if s=NIL then begin
  142.                 SelectedObject := self.Shapes[n];
  143.                 exit;
  144.                 end
  145.             else if self.Shapes[n]=s then s := NIL;
  146.  
  147.     SelectedObject := NIL;
  148.  
  149. end;
  150.  
  151. function Canvas.ObjectAt( x, y : word) : Shape;
  152. var
  153.     n : word;
  154. begin
  155.     with self do for n := 1 to NumShapes do
  156.         if Shapes[n].PtInRegion( x, y ) then begin
  157.             ObjectAt := Shapes[n];
  158.             exit;
  159.             end;
  160.     ObjectAt := NIL;
  161. end;
  162.  
  163. procedure Canvas.SelectObject( s : Shape);
  164. begin
  165.     s.Select;
  166. end;
  167.  
  168. procedure Canvas.Lasso( lx1, ly1, lx2, ly2 : word);
  169. const
  170.     PICKRECTANGLE = 10;
  171. var
  172.     n : word;
  173.  
  174.     function InRange( x, y : word) : boolean;
  175.     begin
  176.         InRange := (x>=lx1) and (x<=lx2) and (y>=ly1) and (y<=ly2);
  177.     end;
  178.  
  179. begin
  180.     { if the selection is very small, treat as a pick }
  181.     if (abs(lx2-lx1)+abs(ly2-ly1))<PICKRECTANGLE then with self do
  182.         for n := 1 to NumShapes do
  183.             if Shapes[n].PtInRegion(lx2, ly2) then begin
  184.                 Shapes[n].Select;
  185.                 exit;
  186.                 end;
  187.  
  188.     { selection is big, do a group pick }
  189.     with self do
  190.         for n := 1 to NumShapes do with Shapes[n] do
  191.             if InRange( x, y) and InRange( x+xe, y+ye ) then Select;
  192.  
  193. end;
  194.  
  195. procedure Canvas.Move( dx, dy : integer);
  196. var
  197.     n : word;
  198. begin
  199.     for n := 1 to self.NumShapes do with self.Shapes[n] do
  200.         if Selected then Move( dx, dy);
  201. end;
  202.  
  203. procedure Canvas.Size( dx, dy : integer);
  204. var
  205.     n : word;
  206. begin
  207.     for n := 1 to self.NumShapes do with self.Shapes[n] do
  208.         if Selected then Size( dx, dy);
  209. end;
  210.  
  211. procedure Canvas.ChangeColor( newcolor : word );
  212. var
  213.     n : word;
  214. begin
  215.     for n := 1 to self.NumShapes do with self.Shapes[n] do
  216.         if Selected then color := newcolor;
  217. end;
  218.  
  219. procedure Canvas.UnSelectObject( s : Shape);
  220. begin
  221.     s.UnSelect;
  222. end;
  223.  
  224. procedure Canvas.SelectAllObjects;
  225. var
  226.     n : word;
  227. begin
  228.     with self do
  229.         for n := 1 to NumShapes do
  230.             Shapes[n].Select;
  231. end;
  232.  
  233. procedure Canvas.UnSelectAllObjects;
  234. var
  235.     n : word;
  236. begin
  237.     with self do
  238.         for n := 1 to NumShapes do
  239.             Shapes[n].UnSelect;
  240. end;
  241.  
  242. function Canvas.PtInSelection( x, y : word) : boolean;
  243. var
  244.     rx1, ry1, rx2, ry2 : word;
  245. begin
  246.     self.GetRange( rx1, ry1, rx2, ry2);
  247.     with self do
  248.         PtInSelection :=    ((x+HITPOINTTOLERANCE)>rx1) and
  249.                             ((x-HITPOINTTOLERANCE)<rx2) and
  250.                             ((y+HITPOINTTOLERANCE)>ry1) and
  251.                             ((y-HITPOINTTOLERANCE)<ry2);
  252. end;
  253.  
  254. procedure Canvas.GetRange( var rx1, ry1, rx2, ry2 : word);
  255. var
  256.     n : word;
  257. begin
  258.     rx1 := 65535;
  259.     ry1 := 65535;
  260.     rx2 := 0;
  261.     ry2 := 0;
  262.     for n := 1 to self.NumShapes do with self.Shapes[n] do
  263.         if Selected then begin
  264.                 rx1 := min( x, min( rx1, x+xe) );
  265.                 ry1 := min( y, min( ry1, y+ye) );
  266.                 rx2 := max( x, max( rx2, x+xe) );
  267.                 ry2 := max( y, max( ry2, y+ye) );
  268.                 end;
  269. end;
  270.  
  271. function Canvas.OnHandle( px, py : word) : boolean;
  272. var
  273.     n : word;
  274.     ax, ay : word;
  275. begin
  276.     with self do for n := 1 to NumShapes do
  277.         if Shapes[n].OnHandle( px, py, ax, ay) then begin
  278.             OnHandle := TRUE;
  279.             exit;
  280.             end;
  281.     OnHandle := FALSE;
  282. end;
  283.  
  284. procedure Canvas.Save( fn : string);
  285. var
  286.     f : file;
  287.     n : word;
  288.     nw : word;
  289. begin
  290. {$I-}
  291.     assign(f, fn);
  292.     rewrite(f, 1);
  293. {$I+}
  294.     if IoResult<>0 then exit;
  295.     BlockWrite( f, CANVASSTAMP, sizeof(CANVASSTAMP), nw);
  296.     with self do begin
  297.         BlockWrite( f, NumShapes, sizeof(NumShapes), nw);
  298.         for n := 1 to NumShapes do
  299.             Shapes[n].Save(f);
  300.         end;
  301.     close(f);
  302. end;
  303.  
  304. procedure Canvas.Load( fn : string);
  305. var
  306.     f : file;
  307.     n : word;
  308.     ns : word;
  309.     s : word;
  310.     nr : word;
  311.     t  : ShapeTypes;
  312.  
  313.     re : rectangle;
  314.     fr : FRectangle;
  315.     el : Ellipse;
  316.     fe : FEllipse;
  317.     gt : GText;
  318.     li : Line;
  319.  
  320. begin
  321. {$I-}
  322.     assign(f, fn);
  323.     reset(f, 1);
  324. {$I+}
  325.     if IOResult<>0 then exit;
  326.  
  327.     BlockRead( f, s, sizeof(s), nr);
  328.     if (IOResult=0) and (s=CANVASSTAMP) then with self do begin
  329.         BlockRead( f, ns, sizeof(ns), nr);
  330.         for n := 1 to ns do begin
  331.             BlockRead( f, t, sizeof(t), nr);
  332.             case t of
  333.                 sRectangle :    begin
  334.                                     new(re);
  335.                                     Re.Load( f);
  336.                                     if not self.AddShape(re) then Dispose(re);
  337.                                 end;
  338.                 sFRectangle :    begin
  339.                                     new(fr);
  340.                                     fr.Load( f);
  341.                                     if not self.AddShape(fr) then Dispose(fr);
  342.                                 end;
  343.                 sEllipse :         begin
  344.                                     new(el);
  345.                                     el.Load( f);
  346.                                     if not self.AddShape(el) then Dispose(el);
  347.                                 end;
  348.                 sFEllipse :        begin
  349.                                     new(fe);
  350.                                     fe.Load( f);
  351.                                     if not self.AddShape(fe) then Dispose(fe);
  352.                                 end;
  353.                 sGText :         begin
  354.                                     new(gt);
  355.                                     gt.Load( f);
  356.                                     if not self.AddShape(gt) then Dispose(gt);
  357.                                 end;
  358.                 sLine :         begin
  359.                                     new(li);
  360.                                     li.Load( f);
  361.                                     if not self.AddShape(li) then Dispose(li);
  362.                                 end;
  363.                 else    RunError(191);
  364.                 end; { case }
  365.             end; { for n := 1 to ns }
  366.             self.Erase;
  367.             self.Draw;
  368.         end; { if stamp = }
  369.     close(f);
  370. end;
  371.  
  372. begin
  373. end.
  374.